#include <tcl.h>
#include <tclint.h>
#include <string.h>
#include "debug.h"

#include "f_core.h"
#include "f_ops.h"
#include "f_ops2.h"
#include "f_bool.h"
#include "f_varops.h"
#include "f_unlazy.h"
#include "f_macro.h"

#include "inspect.h"

extern const Tcl_ObjType *listType;

static void tuple_FreeInternalRepProc(Tcl_Obj *);
static void tuple_DupInternalRepProc(Tcl_Obj *src,Tcl_Obj *dst);
static void tuple_UpdateStringProc(Tcl_Obj *);
static int tuple_SetFromAnyProc(Tcl_Interp *interp,Tcl_Obj *obj);


const Tcl_ObjType tupleTypeD = {
    "tuple",
    tuple_FreeInternalRepProc,
    tuple_DupInternalRepProc,
    tuple_UpdateStringProc,
    tuple_SetFromAnyProc
};
const Tcl_ObjType *tupleType=&tupleTypeD;

static void lazy_FreeInternalRepProc(Tcl_Obj *);
static void lazy_DupInternalRepProc(Tcl_Obj *src,Tcl_Obj *dst);
static void lazy_UpdateStringProc(Tcl_Obj *);
//static int tuple_SetFromAnyProc(Tcl_Interp *interp,Tcl_Obj *obj);

const Tcl_ObjType lazyTypeD = {
    "lazy",
    lazy_FreeInternalRepProc,
    lazy_DupInternalRepProc,
    lazy_UpdateStringProc,
    NULL //lazy_SetFromAnyProc
};
const Tcl_ObjType *lazyType=&lazyTypeD;

#if !defined(memdup)
__inline void *
memdup(void *src,int len)
{
    void *dst;
    dst=Tcl_Alloc(len);
    memcpy(dst,src,len);
    return dst;
}
#endif


Cons *
consAlloc(Tcl_Obj *obj)
{
    Cons *cons;
    cons=(Cons *)Tcl_Alloc(sizeof(Cons));
    if (cons==NULL) return NULL;
    memset(cons,0,sizeof(Cons));
    if (obj!=NULL) {
        Tcl_IncrRefCount(obj);
        cons->obj=obj;
    }
    return cons;
}
Cons *
consFree(Cons *cons)
{
    Cons *next;
    if (cons==NULL) return NULL;
    next=cons->next;
    if (cons->obj!=NULL) Tcl_DecrRefCount(cons->obj);
    Tcl_Free((char *)cons);
    return next;
}

static void
tuple_FreeInternalRepProc(Tcl_Obj *obj)
{
    SHOULD(obj!=NULL,return);
    SHOULD(obj->typePtr==tupleType,return);
    while(TUPLE(obj)->head)
        TUPLE(obj)->head=consFree(TUPLE(obj)->head);
    TUPLE(obj)->tail=NULL;
    obj->typePtr=NULL;
}

static void
tuple_DupInternalRepProc(Tcl_Obj *src,Tcl_Obj *dst)
{
    Cons *cons;
    SHOULD(src!=NULL && src->typePtr==tupleType, return);
    SHOULD(dst!=NULL,return);
    if (TUPLE(src)->head!=NULL) {
        TUPLE(dst)->head=TUPLE(dst)->tail=consAlloc(TUPLE(src)->head->obj);
        for(cons=TUPLE(src)->head->next;cons!=NULL;cons=cons->next) {
            if (cons->obj==NULL) continue;
            TUPLE(dst)->tail=TUPLE(dst)->tail->next=consAlloc(cons->obj);
        }
    } else {
        TUPLE(dst)->head=TUPLE(dst)->tail=NULL;
    }
    dst->typePtr=tupleType;
}

/** дублировать ячейки */
Cons *
consClone(Cons *from,Cons *to,Cons **saveTail)
{
    Cons *head,*tail,*cons;
    if (from==NULL) return NULL;
    if (to==NULL) to=from;
    head=tail=consAlloc(from->obj);
    if (to!=from) for(cons=from->next;cons!=NULL && to->next!=cons;cons=cons->next) {
        if (cons->obj==NULL) continue;
        tail=tail->next=consAlloc(cons->obj);
        if (cons==to) break;
    }
    if (saveTail!=NULL) *saveTail=tail;
    return head;
}
/* вернуть первую значащую ячейку */
Cons *
consFirst(Cons *from,Cons *to) {
    Cons *cons;
    for(cons=from;cons!=NULL;cons=cons->next) {
        if (cons->obj!=NULL) return cons;
        if (cons==to) return NULL;
    }
    return NULL;
}
Cons *
tupleFirstCons(Tcl_Interp *interp,Tcl_Obj *tupleObj)
{
    SHOULD(tupleObj!=NULL,return NULL);
    if (tupleObj->typePtr==lazyType) {
        lazyObjExec(tupleObj,1);
    }
    SHOULD(tupleObj->typePtr==tupleType || Tcl_ConvertToType(interp,tupleObj,tupleType)==TCL_OK,return NULL);
    Cons *cons;
    for(cons=TUPLE(tupleObj)->head;cons;cons=cons->next)
        if (cons->obj!=NULL) return cons;
    return NULL;
}
Cons *
tupleNextCons(Tcl_Interp *interp,Tcl_Obj *tupleObj,Cons *cons)
{
    (void)interp;
    if (cons==NULL) return NULL;
    SHOULD(tupleObj!=NULL,return NULL);
    SHOULD(tupleObj->typePtr==tupleType,return NULL);
    for(cons=cons->next;cons;cons=cons->next) {
        if (cons->obj!=NULL) return cons;
        if (cons==TUPLE(tupleObj)->tail) return NULL;
    }
    return NULL;
}

/** если cons содержит кортеж, то поместить его следом за cons
    FIXME: может лажать: если cons->next=NULL, может соскочить tail у верхнего tuple
*/
Cons *
consExpand(Cons *cons,Cons **fixtail)
{
    Cons *head,*tail;
    if (cons==NULL || cons->obj==NULL || cons->obj->typePtr!=tupleType) return NULL;
    if (Tcl_IsShared(cons->obj)) {
        head=consClone(TUPLE(cons->obj)->head,TUPLE(cons->obj)->tail,&tail);
    } else {
        head=TUPLE(cons->obj)->head;
        tail=TUPLE(cons->obj)->tail;
        TUPLE(cons->obj)->head=TUPLE(cons->obj)->tail=NULL;
    }
    if (head==NULL) return NULL;
    tail->next=cons->next;
    cons->next=head;
    if (cons->obj!=NULL) Tcl_DecrRefCount(cons->obj);
    cons->obj=NULL;
    // через костыль fixtail передаётся указатель на tail который возможно надо править
    if (fixtail!=NULL && tail->next==NULL && ((NULL==*fixtail) || (cons==*fixtail))) {
        *fixtail=tail;
    }
    return tail;
}
/** ячейки между from и to упаковать в два кортежа одинакового размера
*/
void
consCollapse(Cons *from,Cons *to)
{
    int count;
    Cons *cons,*median;
    Tcl_Obj *part1,*part2;
    
    if (from==NULL || to==NULL ||
        from->next==to || from->next==NULL ||
        from->next->next==to || from->next->next==NULL) return ;
    median=from->next;
    cons=median->next;
    count=0;
    for(;cons->next!=NULL && cons->next!=to;cons=cons->next) {
        if (cons->obj==NULL) continue;
        count++;
        if (count==2) {
            count=0;
            do {
                median=median->next;
            } while(median->obj==NULL);
        }
    }
    if (median->next==NULL || median->next==to ||
        median->next->next==NULL || median->next->next==to) return;
    part1=tupleObjNew();
    part2=tupleObjNew();
    TUPLE(part1)->head=from->next;
    TUPLE(part1)->tail=median;
    TUPLE(part2)->head=median->next;
    TUPLE(part2)->tail=cons;
    TUPLE(part1)->tail->next=NULL;
    TUPLE(part2)->tail->next=NULL;
    from->next=consAlloc(part1);
    from->next->next=consAlloc(part2);
    from->next->next->next=to;
}
static void
tuple_UpdateStringProc(Tcl_Obj *obj)
{
    Tcl_Obj *list;  // пока-что конверсия в строку - через временный список
    Cons *cons;
    list=Tcl_NewListObj(0,NULL);
    Tcl_IncrRefCount(list);
    for(cons=TUPLE(obj)->head;cons!=NULL;cons=cons->next) {
        if (cons->obj==NULL) continue;
        if (cons->obj->typePtr==lazyType) {
            lazyObjExec(cons->obj,1);
        }
        if (cons->obj->typePtr==tupleType) {
            consExpand(cons,&TUPLE(obj)->tail);
            continue;
        }
        Tcl_ListObjAppendElement(NULL,list,cons->obj);
    }
    obj->bytes=Tcl_GetStringFromObj(list,&obj->length);
//    list->bytes=Tcl_Alloc(1);
//    list->bytes[0]=0;
//    list->length=0;
    list->bytes=NULL;
    list->length=0;
    Tcl_DecrRefCount(list);
}

static int
tuple_SetFromAnyProc(Tcl_Interp *interp,Tcl_Obj *obj) {
    Cons *head,*tail;
    Tcl_Obj **objv;
    int objc;
    if (Tcl_ConvertToType(interp,obj,listType)!=TCL_OK) return TCL_ERROR;
    if (Tcl_ListObjGetElements(interp,obj,&objc,&objv)!=TCL_OK) return TCL_ERROR;
    if (objc==0) head=tail=NULL;
    else {
        int c;
        head=tail=consAlloc(objv[0]);
        for(c=1;c<objc;c++)
            tail=tail->next=consAlloc(objv[c]);
    }
    obj->typePtr->freeIntRepProc(obj);
    obj->typePtr=tupleType;
    TUPLE(obj)->head=head;
    TUPLE(obj)->tail=tail;
    return TCL_OK;
}

Tcl_Obj *
tupleObjNew()
{
    Tcl_Obj *obj;
    obj=Tcl_NewObj();
    Tcl_InvalidateStringRep(obj);
    obj->typePtr=tupleType;
    TUPLE(obj)->head=NULL;
    TUPLE(obj)->tail=NULL;
    return obj;
}
Tcl_Obj *
tupleObjFromAny(Tcl_Interp *interp,Tcl_Obj *obj)
{
    Tcl_Obj *tupleObj;
    tupleObj=tupleObjNew();
    tupleObjPut(interp,tupleObj,obj);
    return tupleObj;
}
/* конвертировать существующий объект в tuple
    если задан флаг foredit и объект зашарен, то создать незашаренный дубликат
*/    
Tcl_Obj *
asTupleObj(Tcl_Interp *interp,Tcl_Obj *obj,int foredit)
{
    Tcl_Obj *tupleObj;
    if (obj==NULL) {
        WARN("NULL object for converse");
        return tupleObjNew();
    }
    if (obj->typePtr==lazyType) {
        // lazy нельзя конвертировать - его надо просто вложить в tuple
        tupleObj=tupleObjNew();
        tupleObjPut(interp,tupleObj,obj);
    } else if (obj->typePtr!=tupleType) {
        // а прочие можно и нужно
        if (Tcl_ConvertToType(interp,obj,tupleType)!=TCL_OK) {
            ERR("in type conversion");
            return NULL;
        }
    }
    if (foredit && Tcl_IsShared(obj)) {
        obj=Tcl_DuplicateObj(obj);
    }
    return obj;
}

void
tupleObjPut(Tcl_Interp *interp, Tcl_Obj *tupleObj,Tcl_Obj *obj)
{
    if (obj==NULL) return;
    SHOULD(tupleObj!=NULL,return);
    SHOULD(tupleObj->typePtr==tupleType || Tcl_ConvertToType(interp,obj,tupleType)==TCL_OK, return);
    if (TUPLE(tupleObj)->head==NULL)
        TUPLE(tupleObj)->head=TUPLE(tupleObj)->tail=consAlloc(obj);
    else
        TUPLE(tupleObj)->tail=TUPLE(tupleObj)->tail->next=consAlloc(obj);
}
void
tupleObjPush(Tcl_Interp *interp, Tcl_Obj *tupleObj,Tcl_Obj *obj)
{
    if (obj==NULL) return;
    SHOULD(tupleObj!=NULL,return);
    SHOULD(tupleObj->typePtr==tupleType || Tcl_ConvertToType(interp,obj,tupleType)==TCL_OK, return);
    if (TUPLE(tupleObj)->head==NULL)
        TUPLE(tupleObj)->head=TUPLE(tupleObj)->tail=consAlloc(obj);
    else {
        Cons *cons;
        cons=consAlloc(obj);
        cons->next=TUPLE(tupleObj)->head;
        TUPLE(tupleObj)->head=cons;
    }
}
/** вернуть первый объект из набора
*/
#define ALLOW_LAZY 1
#define ALLOW_TUPLE 2

Tcl_Obj *
tupleObjGet(Tcl_Interp *interp,Tcl_Obj *tupleObj,int flags)
{
    SHOULD(tupleObj!=NULL,return NULL);
    SHOULD(tupleObj->typePtr==tupleType || Tcl_ConvertToType(interp,tupleObj,tupleType)==TCL_OK,return NULL);
    if (TUPLE(tupleObj)->head==NULL) return NULL;
    do {
        // удалять пустые ячейки из начала кортежа
        while (TUPLE(tupleObj)->head->obj==NULL) {
            TUPLE(tupleObj)->head=consFree(TUPLE(tupleObj)->head);
            if (TUPLE(tupleObj)->head==NULL) {
                TUPLE(tupleObj)->tail=NULL;
                break;
            }
        }
        // если разрешено возвращать вложеные кортежи или процедуры - то вернуть их
        if (((flags & ALLOW_TUPLE) && TUPLE(tupleObj)->head->obj->typePtr==tupleType) ||
            ((flags & ALLOW_LAZY) && TUPLE(tupleObj)->head->obj->typePtr==lazyType) ) {
            break;
        }
        // иначе объединять наборы и исполнять процедуры
        if (TUPLE(tupleObj)->head->obj->typePtr==tupleType) consExpand(TUPLE(tupleObj)->head,&TUPLE(tupleObj)->tail);
        if (TUPLE(tupleObj)->head->obj->typePtr==lazyType) Tcl_GetString(TUPLE(tupleObj)->head->obj);
    } while(TUPLE(tupleObj)->head!=NULL && TUPLE(tupleObj)->head->obj==NULL);
    Tcl_Obj *ret;
    if (TUPLE(tupleObj)->head==NULL) return NULL;
    // требуемый объект лежит в начале кортежа, взять его
    ret=TUPLE(tupleObj)->head->obj;
    TUPLE(tupleObj)->head->obj=NULL;
    // и снова поудалять пустые ячейки из начала кортежа
    while (TUPLE(tupleObj)->head->obj==NULL) {
        TUPLE(tupleObj)->head=consFree(TUPLE(tupleObj)->head);
        if (TUPLE(tupleObj)->head==NULL) {
            TUPLE(tupleObj)->tail=NULL;
            break;
        }
    }
    return ret;    
}

int
tupleObjCmd(ClientData data,Tcl_Interp *interp,int objc,Tcl_Obj *const objv[])
{
    Tcl_Obj *tupleObj;
    int c;
    (void)data;
    tupleObj=tupleObjNew();
    for(c=1;c<objc;c++)
        tupleObjPut(interp,tupleObj,objv[c]);
    Tcl_SetObjResult(interp,tupleObj);
    return TCL_OK;
}

static void
lazy_FreeInternalRepProc(Tcl_Obj *obj)
{
    if (obj==NULL || obj->typePtr!=lazyType || LAZY(obj)==NULL) return;
    Tcl_DecrRefCount(LAZY(obj)->cmd);
    Tcl_Free((char *)LAZY(obj));
    LAZY(obj)=NULL;
    obj->typePtr=NULL;
}
static void
lazy_DupInternalRepProc(Tcl_Obj *src,Tcl_Obj *dst)
{
    if (src==NULL || src->typePtr!=lazyType || LAZY(src)==NULL) {
        ERR("not a lazy");
        return;
    }
    if (dst==NULL) {
        ERR("no dest");
        return;
    }
    // 
    (void)Tcl_GetString(src);//lazy_mutate(src);   // исполнить и "мутировать" в результат
    if (src->typePtr!=NULL && src->typePtr->dupIntRepProc!=NULL)
        src->typePtr->dupIntRepProc(src,dst);
    else {
        Tcl_GetString(src);    // получить текстовое предсавление
        Tcl_SetStringObj(dst,src->bytes,src->length);   // копировать строки
    }
}
static void
mutate(Tcl_Obj *src,Tcl_Obj *dst) {
    SHOULD(src!=NULL,return);
    SHOULD(dst!=NULL,return);
//    TRACE("dst->bytes=%p",dst->bytes);
//    Tcl_InvalidateStringRep(dst);
    if (dst->typePtr!=NULL && dst->typePtr->freeIntRepProc!=NULL) {
        TRACE("free %p",dst);
        dst->typePtr->freeIntRepProc(dst);
    }
    if (src->typePtr!=NULL && src->typePtr->dupIntRepProc!=NULL) {
        src->typePtr->dupIntRepProc(src,dst);
        dst->typePtr=src->typePtr;
    } else {
        memcpy(&dst->internalRep,&src->internalRep,sizeof(src->internalRep));
        dst->typePtr=src->typePtr;
    }
    if (src->bytes!=NULL) {
        TRACE("copy bytes");
        dst->bytes=memdup(src->bytes,src->length+1);
        dst->length=src->length;
    } else if (dst->typePtr!=lazyType && dst->typePtr!=tupleType && dst->typePtr!=listType) {
        Tcl_GetString(dst);
    }
}
static void
mutateToTuple(Tcl_Obj *src,Tcl_Obj *dst) {
    SHOULD(src!=NULL,return);
    SHOULD(dst!=NULL,return);
    Tcl_InvalidateStringRep(dst);
    if (dst->typePtr!=NULL && dst->typePtr->freeIntRepProc!=NULL) {
        dst->typePtr->freeIntRepProc(dst);
    }
    dst->typePtr=tupleType;
    if (src->typePtr==tupleType) {
        if (Tcl_IsShared(src)) {
            TUPLE(dst)->head=consClone(TUPLE(src)->head,TUPLE(src)->tail,&TUPLE(dst)->tail);
        } else {
            TUPLE(dst)->head=TUPLE(src)->head;
            TUPLE(dst)->tail=TUPLE(src)->tail;
            TUPLE(src)->head=TUPLE(src)->tail=NULL;
        }
    } else {
        tupleObjPut(NULL,dst,src);
    }
}
/* вызвать команду напрямую, по возможности минуя Tcl_Eval */
static int
call(Tcl_Interp *interp,int objc,Tcl_Obj *const objv[],int flag)
{
    Tcl_Command cmd;
    Tcl_CmdInfo info;
    cmd=Tcl_GetCommandFromObj(interp,objv[0]);
    if (cmd!=NULL && (Tcl_GetCommandInfo(interp,Tcl_GetString(objv[0]),&info)==TCL_OK) && info.objProc!=NULL) {
        TRACE("direct call");
        return info.objProc(info.clientData,interp,objc,objv);
    }
//    INSPECT_ARRAY(-1,objc,objv,"command before call");
    // придётся-таки вызывать evalobj
    return Tcl_EvalObjv(interp,objc,objv,flag);
}
static int
callObj(Tcl_Interp *interp,Tcl_Obj *obj,...)
{
    int objc;
    Tcl_Obj **objv;
    int code;
    if (Tcl_IsShared(obj))
        obj=Tcl_DuplicateObj(obj);
    Tcl_IncrRefCount(obj);
    if (Tcl_ListObjGetElements(interp,obj,&objc,&objv)!=TCL_OK) return TCL_ERROR;
    code=call(interp,objc,objv,0);
//    INSPECT_OBJ(obj,"command after call");
//    INSPECT_OBJ(Tcl_GetObjResult(interp),"command result");
    Tcl_DecrRefCount(obj);
    return code;
}
void
lazyObjExec(Tcl_Obj *lazyObj,int processDirty) {
    int code;
    Tcl_Obj *obj;
    Tcl_Obj *result;
    if (lazyObj==NULL || lazyObj->typePtr!=lazyType || LAZY(lazyObj)==NULL) return;
    obj=lazyObj;
    Tcl_IncrRefCount(obj);
    do {
        Tcl_Interp *interp;
        Tcl_Namespace *ns;
        Tcl_CallFrame *frame;
        Tcl_Obj *cmd;
        interp=LAZY(obj)->interp;
        ns=LAZY(obj)->ns;
        if (processDirty && LAZY(obj)->dirty!=NULL) {
            Tcl_Obj *dirtyTuple;
            Tcl_Obj *prev;
            TRACE("DIRTY");
            dirtyTuple=Tcl_GetAssocData(interp,LAZY(obj)->dirty,NULL);
            if (dirtyTuple!=NULL) {
                while((prev=tupleObjGet(interp,dirtyTuple,ALLOW_LAZY))!=NULL && prev!=obj)
                    lazyObjExec(prev,0);
            }
        }
        //TRACE("lazy exec:%s",Tcl_GetString(LAZY(obj)->cmd));
        frame=NULL;
        if (ns!=NULL && Tcl_GetCurrentNamespace(interp)!=ns) {
            TclPushStackFrame(interp,&frame,ns,0);
        }
//        cmd=LAZY(obj)->cmd;
//        Tcl_IncrRefCount(cmd);
//        Tcl_GetString(cmd); // <- BUG !!! FIXME !!! наличие lazy к команде приводит к краху 
//        code=Tcl_EvalObjEx(interp,cmd,0);
        code=callObj(interp,LAZY(obj)->cmd,NULL);
        result=Tcl_GetObjResult(interp);
        if (frame!=NULL) {
            TclPopStackFrame(interp);
        }
        if (result==obj || result==lazyObj) {
            ERR("infiniite loop? cmd=%s",Tcl_GetString(LAZY(obj)->cmd));
//            Tcl_DecrRefCount();
            break;
        }
        if (result->typePtr==lazyType) {
            TRACE("REPEATE!!");
        }
        Tcl_DecrRefCount(obj);
        obj=result;// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        Tcl_IncrRefCount(obj);
        if (code!=TCL_OK && code!=TCL_RETURN) {
//            Tcl_DecrRefCount(cmd);
            TRACE("ERROR");
            break;
        } else {
            ;//TRACE("OK");
        }
//        Tcl_DecrRefCount(cmd);
    } while(obj->typePtr==lazyType);
    Tcl_DecrRefCount(obj);
    if (code==TCL_OK || code==TCL_RETURN) {
        mutateToTuple(obj,lazyObj);
        //mutate(obj,lazyObj);
    } else {
        if (lazyObj->typePtr==lazyType) {
            Tcl_DecrRefCount(LAZY(lazyObj)->cmd);
            Tcl_Free((char *)LAZY(lazyObj));
            LAZY(lazyObj)=NULL;
            lazyObj->typePtr=NULL;
        }
        ERR("Error in execution !!!");
    }
}
static void
lazy_UpdateStringProc(Tcl_Obj *obj) {
    Tcl_InterpState st;
    Tcl_Interp *interp;
    if (obj==NULL || obj->typePtr!=lazyType || LAZY(obj)==NULL) {
        ERR("not a lazy object");
        return;
    }
    interp=LAZY(obj)->interp;
    st=Tcl_SaveInterpState(interp,TCL_OK);
    // исполнить отложенную функцию
    lazyObjExec(obj,1);
    Tcl_GetString(obj);
    Tcl_RestoreInterpState(interp,st);
}
// полностью удалить список "грязных" функций
static void
destroyDirtyTuple(ClientData data,Tcl_Interp *interp)
{
    Tcl_Obj *dirtyTuple;
    (void)interp;
    dirtyTuple=(Tcl_Obj *)data;
    if (dirtyTuple==NULL || dirtyTuple->typePtr!=tupleType) return;
    Tcl_DecrRefCount(dirtyTuple);
}

// создать новую отложенную функцию
Tcl_Obj *
lazyObjNew(Tcl_Interp *interp,char *key,int objc,Tcl_Obj *const objv[],...)
{
    Tcl_Obj *obj;
    Lazy *lazy;
    lazy=(Lazy *)Tcl_Alloc(sizeof(Lazy));
    lazy->interp=interp;
    lazy->ns=Tcl_GetCurrentNamespace(interp);
    
    lazy->cmd=Tcl_NewListObj(objc,objv);
    Tcl_IncrRefCount(lazy->cmd);
    
    Tcl_Obj *element;
    va_list ap;
    va_start(ap,objv);
    while((element=va_arg(ap,Tcl_Obj *))!=NULL)
        Tcl_ListObjAppendElement(interp,lazy->cmd,element);
    va_end(ap);
    
    lazy->dirty=key;
    obj=Tcl_NewObj();
    obj->typePtr=lazyType;
    LAZY(obj)=lazy;

    if (key!=NULL) {
        Tcl_Obj *dirtyTuple;
        dirtyTuple=Tcl_GetAssocData(interp,key,NULL);
        if (dirtyTuple==NULL) {
            dirtyTuple=tupleObjNew();
            Tcl_IncrRefCount(dirtyTuple);
            Tcl_SetAssocData(interp,key,destroyDirtyTuple,dirtyTuple);
        }
        tupleObjPut(interp,dirtyTuple,obj);
    }
    Tcl_InvalidateStringRep(obj);
    return obj;
}

int
lazyObjCmd(ClientData data,Tcl_Interp *interp,int objc,Tcl_Obj *const objv[])
{
    Tcl_Obj *lazyObj;
    lazyObj = lazyObjNew(interp,(char *)data,objc-1,objv+1,NULL);
    Tcl_SetObjResult(interp,lazyObj);
    return TCL_OK;
}
const Tcl_ObjType *listType;
const Tcl_ObjType *dictType;
int
Tuple_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp,TCL_VERSION,0)==NULL) return TCL_ERROR;
    listType=Tcl_GetObjType("list");
    dictType=Tcl_GetObjType("dict");
    Tcl_RegisterObjType(tupleType);
    Tcl_RegisterObjType(lazyType);
    Tcl_RegisterObjType(markerType);
    if (Tcl_CreateObjCommand(interp,"inspect",inspectObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"inspect\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"tuple",tupleObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"tuple\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"pure",lazyObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"pure\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"dirty",lazyObjCmd,"dirty",NULL)==NULL) {
        ERR("on create \"dirty\" command");
        return TCL_ERROR;
    }
    /** commands from f_ops */
    if (Tcl_CreateObjCommand(interp,"head",headObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"head\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"rest",restObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"rest\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"front",frontObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"front\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"tail",tailObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"tail\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"rotate",rotateObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"rotate\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"twin",twinObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"twin\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"rtwin",rtwinObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"rtwin\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"first",firstObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"first\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"last",lastObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"last\" command");
        return TCL_ERROR;
    }
    /** command from f_ops2 */
    if (Tcl_CreateObjCommand(interp,"compact",compactObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"compact\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"map",mapObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"map\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"reverse",reverseObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"reverse\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"fold",foldObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"fold\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"filter",filterObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"filter\" command");
        return TCL_ERROR;
    }
    /** commands from f_bool */
    if (Tcl_CreateObjCommand(interp,"T",T_ObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"T\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"F",T_ObjCmd,"false",NULL)==NULL) {
        ERR("on create \"F\" command");
        return TCL_ERROR;
    }
    /** command from f_varops */    
    if (Tcl_CreateObjCommand(interp,"vpush",vpushObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"vpush\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"vput",vputObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"vput\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"vget",vgetObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"vget\" command");
        return TCL_ERROR;
    }
    /** from unlazy **/
    if (Tcl_CreateObjCommand(interp,"unlazy",unlazyObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"unlazy\" command");
        return TCL_ERROR;
    }
    /** from f_macro */
    if (Tcl_CreateObjCommand(interp,"macro",macroObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"macro\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"invoke",invokeObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"invoke\" command");
        return TCL_ERROR;
    }
    if (Tcl_CreateObjCommand(interp,"marker",markerObjCmd,NULL,NULL)==NULL) {
        ERR("on create \"marker\" command");
        return TCL_ERROR;
    }
    return TCL_OK;
}
